home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / risc_src.lha / risc_sources / sys / risc_bignum.t < prev    next >
Text File  |  1990-01-30  |  4KB  |  94 lines
  1. (herald risc_bignum (env tsys))
  2.  
  3. ;;; Copyright (c) 1985 Yale University
  4. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  5. ;;; This material was developed by the T Project at the Yale University Computer 
  6. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  7. ;;; and to use it for any purpose is granted, subject to the following restric-
  8. ;;; tions and understandings.
  9. ;;; 1. Any copy made of this software must include this copyright notice in full.
  10. ;;; 2. Users of this software agree to make their best efforts (a) to return
  11. ;;;    to the T Project at Yale any improvements or extensions that they make,
  12. ;;;    so that these may be included in future releases; and (b) to inform
  13. ;;;    the T Project of noteworthy uses of this software.
  14. ;;; 3. All materials developed as a consequence of the use of this software
  15. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  16. ;;;    of acknowledging credit in academic research.
  17. ;;; 4. Yale has made no warrantee or representation that the operation of
  18. ;;;    this software will be error-free, and Yale is under no obligation to
  19. ;;;    provide any services, by way of maintenance, update, or otherwise.
  20. ;;; 5. In conjunction with products arising from the use of this material,
  21. ;;;    there shall be no use of the name of the Yale University nor of any
  22. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  23. ;;;    without prior written consent from Yale in each case.
  24. ;;;
  25.  
  26. (define (set-bignum-length! bignum length)
  27.   (lap ()
  28.     (load l (d@r a1 -2) scratch)
  29.     (sra ($ 8) scratch)            ; length in bytes
  30.     (sll ($ 2) scratch)
  31.     (sub A2 scratch)                 ; size of bogus bytev including header
  32.     (j= scratch zero %bignum-length-unchanged)
  33.     (sub ($ 4) scratch)              ; bytev length
  34.     (sll ($ 8) scratch)
  35.     (or ($ header/bytev) scratch)  ; bogus bytev header
  36.     (add a2 a1 vector)
  37.     (store l scratch (d@r vector 2))
  38.     (sll ($ 6) a2 scratch)
  39.     (load ub (d@r A1 template/header) vector)
  40.     (or vector scratch)
  41.     (store l scratch (d@r A1 -2))
  42. %bignum-length-unchanged
  43.     (jr link-reg)
  44.     (move ($ -2) NARGS)))
  45.  
  46.  
  47. (define-constant bignum-positive? alt-bit-set?)
  48.  
  49.  
  50. (define-constant bignum-negate!
  51.   (primop bignum-negate! ()
  52.     ((primop.side-effects? self) t)
  53.     ((primop.generate self node)                               
  54.      (let ((reg (->register node (leaf-value ((call-arg 2) node)))))
  55.        (emit risc/load 'ub (reg-offset reg template/header) scratch)
  56.        (emit risc/xor (machine-num #b10000000) scratch scratch)
  57.        (emit risc/store 'b scratch (reg-offset reg template/header))))
  58.     ((primop.type self node)
  59.      '#[type (proc #f (proc #f top) bignum)])))
  60.  
  61. (define (%digit-divide x1 x0 y)   ; Divide x1x0 by y with x1 < (* 2 y)
  62.   (lap ()
  63.     (srl ($ 2) a1)
  64.     (move A3 scratch)
  65.     (srl ($ 2) scratch)
  66.     (move zero a3)            ;don't fool gc
  67.     (move ($ 30) extra)
  68.     (move zero vector)                ; Quotient in Vector
  69.     (jbr integer-divide-start)
  70.  
  71. integer-divide-loop
  72.     (sll ($ 1) vector)
  73.     (j< a2 zero high-bit-set)
  74.     (sll ($ 1) a2)
  75.     (sll ($ 1) a1)
  76.     (jbr integer-divide-start)
  77. high-bit-set
  78.     (sll ($ 1) a2)
  79.     (sll ($ 1) a1)
  80.     (or ($ 1) a1)
  81. integer-divide-start
  82.     (uj< a1 scratch integer-divide-next)
  83.     (sub scratch a1)
  84.     (or ($ 1) vector)
  85. integer-divide-next
  86.     (sub ($ 1) extra)
  87.     (j>= extra zero integer-divide-loop)
  88.  
  89.     (sll ($ 2) a1)
  90.     (move a1 A2)
  91.     (sll ($ 2) Vector)
  92.     (move Vector A1)
  93.     (jr link-reg)
  94.     (move ($ -3) nargs)))